home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / tm / tm-partial.el.z / tm-partial.el
Encoding:
Text File  |  1998-05-21  |  3.4 KB  |  113 lines
  1. ;;; tm-partial.el --- Grabbing all MIME "message/partial"s.
  2.  
  3. ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
  4.  
  5. ;; Author: OKABE Yasuo @ Kyoto University
  6. ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
  7. ;; Version:
  8. ;;    $Id: tm-partial.el,v 7.15 1997/02/01 18:01:25 morioka Exp $ 
  9. ;; Keywords: mail, news, MIME, multimedia, message/partial
  10.  
  11. ;; This file is a part of tm (Tools for MIME).
  12.  
  13. ;; This program is free software; you can redistribute it and/or
  14. ;; modify it under the terms of the GNU General Public License as
  15. ;; published by the Free Software Foundation; either version 2, or (at
  16. ;; your option) any later version.
  17.  
  18. ;; This program is distributed in the hope that it will be useful, but
  19. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21. ;; General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;; Boston, MA 02111-1307, USA.
  27.  
  28. ;;; Code:
  29.  
  30. (require 'tm-view)
  31. (require 'tm-play)
  32.  
  33. (defvar tm-partial/preview-article-method-alist nil)
  34.    
  35. ;; display Article at the cursor in Subject buffer.
  36. (defun tm-partial/preview-article (target)
  37.   (save-window-excursion
  38.     (let ((f (assq target tm-partial/preview-article-method-alist)))
  39.       (if f
  40.       (funcall (cdr f))
  41.     (error "Fatal. Unsupported mode")
  42.     ))))
  43.  
  44. (defun mime-article/grab-message/partials (beg end cal)
  45.   (interactive)
  46.   (let* ((id (cdr (assoc "id" cal)))
  47.      (mother mime::article/preview-buffer)
  48.      (target (cdr (assq 'major-mode cal)))
  49.      (article-buffer (buffer-name (current-buffer)))
  50.      (subject-buf (eval (cdr (assq 'summary-buffer-exp cal))))
  51.      subject-id
  52.      (root-dir (expand-file-name
  53.             (concat "m-prts-" (user-login-name)) mime/tmp-dir))
  54.      full-file)
  55.     (setq root-dir (concat root-dir "/" (replace-as-filename id)))
  56.     (setq full-file (concat root-dir "/FULL"))
  57.     
  58.     (if (null target)
  59.     (error "%s is not supported. Sorry." target)
  60.       )
  61.     
  62.     ;; if you can't parse the subject line, try simple decoding method
  63.     (if (or (file-exists-p full-file)
  64.         (not (y-or-n-p "Merge partials?"))
  65.         )
  66.     (mime-article/decode-message/partial beg end cal)
  67.       (let (cinfo the-id parameters)
  68.     (setq subject-id (std11-field-body "Subject"))
  69.     (if (string-match "[0-9\n]+" subject-id)
  70.         (setq subject-id (substring subject-id 0 (match-beginning 0)))
  71.       )
  72.     (save-excursion
  73.       (set-buffer subject-buf)
  74.       (while (search-backward subject-id nil t))
  75.       (catch 'tag
  76.         (while t
  77.           (tm-partial/preview-article target)
  78.           (set-buffer article-buffer)
  79.           (set-buffer mime::article/preview-buffer)
  80.           (setq cinfo
  81.             (mime::preview-content-info/content-info
  82.              (car mime::preview/content-list)))
  83.           (setq parameters (mime::content-info/parameters cinfo))
  84.           (setq the-id (assoc-value "id" parameters))
  85.           (if (equal the-id id)
  86.           (progn
  87.             (set-buffer article-buffer)
  88.             (mime-article/decode-message/partial
  89.              (point-min)(point-max) parameters)
  90.             (if (file-exists-p full-file)
  91.             (throw 'tag nil)
  92.               )
  93.             ))
  94.           (if (not (progn
  95.              (set-buffer subject-buf)
  96.              (end-of-line)
  97.              (search-forward subject-id nil t)
  98.              ))
  99.           (error "not found")
  100.         )
  101.           )
  102.         ))))))
  103.  
  104.  
  105. ;;; @ end
  106. ;;;
  107.  
  108. (provide 'tm-partial)
  109.  
  110. (run-hooks 'tm-partial-load-hook)
  111.  
  112. ;;; tm-partial.el ends here
  113.